home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / SEARCH / RUBICON / RBVERIFY.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-21  |  4KB  |  137 lines
  1. {*********************************************************}
  2. {*            RBVERIFY.PAS 1.20             *}
  3. {*      Copyright (c) Tamarack Associates 1996.     *}
  4. {*           All rights reserved.          *}
  5. {*********************************************************}
  6.  
  7. {$B-}     {* Boolean evaluation *}
  8. {$G+}     {* Generate 286 code  *}
  9. {$X+}     {* eXtended syntax    *}
  10.  
  11. unit rbVerify;
  12.  
  13. interface
  14.  
  15. uses
  16.   {$IFDEF WIN32}
  17.   Windows,
  18.   {$ELSE}
  19.   WinTypes, WinProcs,
  20.   {$ENDIF}
  21.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  22.   StdCtrls, Grids, DBGrids, DB, DBTables, ExtCtrls,
  23.   taTools, taRubicn;
  24.  
  25. type
  26.   TForm1 = class(TForm)
  27.     MakeDictionary1: TMakeDictionary;
  28.     WordsDataSource: TDataSource;
  29.     DBGrid1: TDBGrid;
  30.     Panel1: TPanel;
  31.     VerifyBtn: TButton;
  32.     RecNoLabel: TLabel;
  33.     WordsEdit: TEdit;
  34.     WordsTableLabel: TLabel;
  35.     WordsTable: TTable;
  36.     procedure VerifyBtnClick(Sender: TObject);
  37.     procedure WordsEditExit(Sender: TObject);
  38.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  39.   private
  40.     { Private declarations }
  41.     FClosing  : BOOLEAN;
  42.     FContinue : WORD;
  43.   public
  44.     { Public declarations }
  45.     PROCEDURE Process;
  46.   end;
  47.  
  48. var
  49.   Form1: TForm1;
  50.  
  51. implementation
  52.  
  53. {$R *.DFM}
  54.  
  55. PROCEDURE TForm1.Process;
  56. VAR      RecNum   : LONGINT;
  57.       V       : TVerifyRecord;
  58.       B       : TtaBits;
  59. BEGIN
  60.  IF NOT WordsTable.Active THEN
  61.   RAISE EDictionary.Create('WordsTable not open');
  62.  WITH WordsTable DO
  63.   BEGIN
  64.    RecNum := 0;
  65.    FContinue := mrOk;
  66.    First;
  67.    WHILE NOT EOF AND (FContinue = mrOk) DO
  68.     BEGIN
  69.      INC(RecNum);
  70.      RecNoLabel.Caption := IntToStr(RecNum);
  71.      Application.ProcessMessages;
  72.      MakeDictionary1.VerifyRecord(V);
  73.      B := TtaBits(V.CompressedSize);
  74.      {* Compare the count in the record to the bitset *}
  75.      IF B.Count <> Fields[wtWordCount].AsInteger THEN
  76.       FContinue := MessageDlg('Invalid Count (' + IntToStr(B.Count) + ')',
  77.                   mtError,[mbOk,mbCancel],0);
  78.      {* V.BitCount is the difference between the count in the bitset and  *}
  79.      {* a recount of the same bitset.  Should be zero -- no difference.   *}
  80.      IF (FContinue = mrOk) AND (V.BitCount <> 0) THEN
  81.       FContinue := MessageDlg('Invalid Count (' + IntToStr(V.BitCount) + ')',
  82.                   mtError,[mbOk,mbCancel],0);
  83.      {* V.DecompressedSize is the difference between the ABS(BlobSize) and *}
  84.      {* Stream.Size.  Should be zero -- no difference.               *}
  85.      IF (FContinue = mrOk) AND (V.DecompressedSize <> 0) THEN
  86.       FContinue := MessageDlg('Invalid Size (' + IntToStr(V.DecompressedSize) + ')',
  87.                   mtError,[mbOk,mbCancel],0);
  88.      {* For compressed blobs, verify FirstSet and LastSet values *}
  89.      IF Fields[wtBlobSize].AsInteger > 0 THEN
  90.       BEGIN
  91.        IF (FContinue = mrOk) AND (V.FirstSet <> B.FirstSet) THEN
  92.     FContinue := MessageDlg('Invalid FirstSet',mtError,[mbOk,mbCancel],0);
  93.        IF (FContinue = mrOk) AND (V.LastSet <> B.LastSet) THEN
  94.     FContinue := MessageDlg('Invalid LastSet',mtError,[mbOk,mbCancel],0);
  95.       END;
  96.      Next
  97.     END
  98.   END
  99. END;
  100.  
  101. procedure TForm1.VerifyBtnClick(Sender: TObject);
  102. begin
  103.  WITH Sender AS TButton DO
  104.   IF Caption = 'Verify' THEN
  105.    TRY
  106.     IF NOT WordsTable.Active THEN WordsEditExit(NIL);
  107.     Caption := 'Stop';
  108.     Process;
  109.    FINALLY
  110.     Caption := 'Verify'
  111.    END
  112.   ELSE FContinue := mrCancel
  113. end;
  114.  
  115. procedure TForm1.WordsEditExit(Sender: TObject);
  116. begin
  117.  IF FClosing THEN EXIT;
  118.  WITH WordsTable DO
  119.   BEGIN
  120.    Close;
  121.    TableName := AliasToPath(WordsEdit.Text);
  122.    Open;
  123.    IF NOT CheckStructure(WordsTable) THEN
  124.     BEGIN
  125.      Close;
  126.      RAISE EDictionary.Create('Invalid WordsTable structure')
  127.     END
  128.   END
  129. end;
  130.  
  131. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  132. begin
  133.  FClosing := TRUE
  134. end;
  135.  
  136. end.
  137.